unit Checkers.Checker;

interface

uses
  Classes,
  SysUtils,
  // GLScene
  VectorGeometry,
  VectorTypes,
  BaseClasses,
  GLScene,
  GLGeomObjects,
  GLVectorFileObjects,
  GLContext,
  GLMaterial,
  GLRenderContextInfo,
  GLMovement,
  GLSGenerics,
  GLState,
  OpenGLTokens,
  GLWin32Viewer,
  GLUtils,
  // Project
  Checkers.Loader;

type
  // Checker
  // DONE: Models loading
  // DONE: Use proxies to improve performance(?)
  // DONE: Movement animation
  TProxies = Array [0 .. 3] of TCheckerModel;
  TMaterials = Array [0 .. 3] of TGLMaterial;

  TChecker = class(TGLBaseSceneObject)
  private
    FViewType: Integer;
    FProxies: TProxies;
    FCurrentProxy: TCheckerModel;
    FMovement: TGLMovement;
    FPath: TGLMovementPath;
    FSpeedFactor: Single;
    FDissolve: Boolean;
    FTime: Single;
    FLoader: TCheckersLoader;
    FMaterials: TMaterials;
    FAlpha: Single;
    FIsRemoved: Boolean;
    FIsMoving: Boolean;
    FOnMoveComplete: TNotifyEvent;
    function GetViewType: Integer;
    procedure SetViewType(const Value: Integer);
    procedure OnPathTravelStop(Sender: TObject; APath: TGLMovementPath;
      var Looped: Boolean);
    procedure OnPathAllTravelledOver(Sender: TObject);
    procedure Setloader(const Value: TCheckersLoader);
    procedure SetSpeed(const Value: Single);
    procedure SetNodesSpeed(const Value: Single);
    function GetCurrentModel: TCheckerModel;
    function GetIsRemoved: Boolean;
    function GetColor: TVector;
    function GetColorAsAdress: PSingle;
    function GetOnMoveComplete: TNotifyEvent;
    procedure SetOnMoveComplete(const Value: TNotifyEvent);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DoProgress(const progressTime: TProgressTimes); override;
    procedure DoRender(var ARci: TRenderContextInfo;
      ARenderSelf, ARenderChildren: Boolean); override;
    procedure UpdateAlpha;
    procedure StopMovement;
    procedure Reset(const AResetRemovedState: Boolean = True);
    procedure RemoveFromBoard;
    procedure MoveToCell(const ATargetCell: TGLBaseSceneObject);
    destructor Destroy; override;
    property ViewType: Integer read GetViewType write SetViewType;
    property Loader: TCheckersLoader write Setloader;
    property Speed: Single write SetSpeed;
    property CurrentModel: TCheckerModel read GetCurrentModel;
    property IsRemoved: Boolean read GetIsRemoved;
    property Color: TVector read GetColor;
    property ColorAsAdress: PSingle read GetColorAsAdress;
    property OnMoveComplete: TNotifyEvent read GetOnMoveComplete
      write SetOnMoveComplete;
  end;

implementation

{ TChecker }

constructor TChecker.Create(AOwner: TComponent);
var
  vNode: TGLPathNode;
begin
  inherited;
  FMovement := GetOrCreateMovement(Self);
  FMovement.OnPathTravelStop := OnPathTravelStop;
  FMovement.OnAllPathTravelledOver := OnPathAllTravelledOver;
  FPath := FMovement.AddPath;
  FPath.ShowPath := False;
  vNode := FPath.AddNodeFromObject(Self);
  vNode := FPath.AddNode;
  vNode := FPath.AddNode;
  FSpeedFactor := 1.0;
  Pickable := False;
  FDissolve := False;
  FIsRemoved := False;
  FTime := 0;
  FAlpha := 1;
  Visible := False;
end;

procedure TChecker.DoProgress(const progressTime: TProgressTimes);
begin
  inherited;
  FTime := FTime + progressTime.deltaTime * 3;
  UpdateAlpha;
end;

procedure TChecker.DoRender(var ARci: TRenderContextInfo;
  ARenderSelf, ARenderChildren: Boolean);
begin
  if Assigned(FCurrentProxy.Model) then
  begin
    with FCurrentProxy do
      Model.AbsolutePosition := VectorAdd(AbsolutePosition, Offset);
    FCurrentProxy.Model.Render(ARci);
  end;
end;

procedure TChecker.UpdateAlpha;
begin
  if FDissolve then
  begin
    if FAlpha > 0 then
    begin
      FAlpha := 1 - FTime;
      Scene.CurrentBuffer.NotifyChange(Self);
    end
    else
    begin
      FDissolve := False;
      FIsRemoved := True;
    end;
  end;
end;

function TChecker.GetColor: TVector;
begin
  Result := FCurrentProxy.Color;
  Result[3] := FAlpha;
end;

function TChecker.GetColorAsAdress: PSingle;
var
  vColor: TVector;
begin
  vColor := FCurrentProxy.Color;
  vColor[3] := FAlpha;
  Result := @vColor;
end;

function TChecker.GetCurrentModel: TCheckerModel;
begin
  Result := FCurrentProxy;
end;

function TChecker.GetViewType: Integer;
begin
  Result := FViewType;
end;

procedure TChecker.MoveToCell(const ATargetCell: TGLBaseSceneObject);
var
  vEnd, vMiddle: TVector;
  vNode: TGLPathNode;
  vDistance: Single;
begin
  if not FIsMoving then
  begin
    FIsMoving := True;
    vEnd := VectorSubtract(ATargetCell.AbsolutePosition,
      Parent.AbsolutePosition);
    vMiddle := VectorScale(VectorAdd(Position.AsVector, vEnd), 0.5);
    vMiddle[1] := 0.2;
    vMiddle[3] := 1;

    vDistance := VectorDistance(Position.AsVector, vMiddle);
    vDistance := vDistance + VectorDistance(vMiddle, vEnd);
    SetNodesSpeed(vDistance * FSpeedFactor);

    FPath.Nodes[0].PositionAsVector := Position.AsVector;
    FPath.Nodes[1].PositionAsVector := vMiddle;
    FPath.Nodes[2].PositionAsVector := vEnd;
    FMovement.ActivePathIndex := 0;
    FMovement.StartPathTravel;
  end;
end;

procedure TChecker.OnPathAllTravelledOver(Sender: TObject);
begin
  FIsMoving := False;
  if Assigned(FOnMoveComplete) then
    FOnMoveComplete(Self);
end;

procedure TChecker.OnPathTravelStop(Sender: TObject; APath: TGLMovementPath;
  var Looped: Boolean);
begin
  FIsMoving := False;
end;

procedure TChecker.RemoveFromBoard;
begin
  FDissolve := True;
  FTime := 0;
  FIsRemoved := True;
end;

procedure TChecker.StopMovement();
begin
  try
    FMovement.StopPathTravel;
    FMovement.ActivePathIndex := 0;
    Position.AsVector := WHmgVector;
    FOnMoveComplete := nil;
  except
    Exit;
  end;
end;

procedure TChecker.Reset(const AResetRemovedState: Boolean = True);
begin
  StopMovement();
  ViewType := 0;
  if AResetRemovedState then
  begin
    FAlpha := 1;
    FDissolve := False;
    FIsRemoved := False;
  end;
end;

procedure TChecker.Setloader(const Value: TCheckersLoader);
var
  i: Byte;
begin
  FLoader := Value;
  for i := 0 to Length(FProxies) - 1 do
  begin
    FProxies[i] := FLoader.Models[i];
    if FMaterials[i] = nil then
      FMaterials[i] := TGLMaterial.Create(Self);
    FMaterials[i].FrontProperties.Diffuse.Color := FProxies[i].Color;
  end;
end;

procedure TChecker.SetSpeed(const Value: Single);
begin
  FSpeedFactor := Value;
end;

procedure TChecker.SetNodesSpeed(const Value: Single);
var
  i: Integer;
begin
  for i := 0 to FPath.NodeCount - 1 do
    FPath.Nodes[i].Speed := Value;
end;

procedure TChecker.SetViewType(const Value: Integer);
var
  i: Integer;
begin
  FViewType := Value;
  // Visible := FViewType <> 0;
  for i := 0 to Length(FProxies) - 1 do
    if Assigned(FProxies[i].Model) then
      FProxies[i].Model.Visible := False;
  case FViewType of
    1:
      begin
        FCurrentProxy := FProxies[0];
      end;
    2:
      begin
        FCurrentProxy := FProxies[1];
      end;
    -1:
      begin
        FCurrentProxy := FProxies[2];
      end;
    -2:
      begin
        FCurrentProxy := FProxies[3];
      end;
  end;
  if Assigned(FCurrentProxy.Model) then
    FCurrentProxy.Model.Visible := True;
end;

function TChecker.GetIsRemoved: Boolean;
begin
  Result := FIsRemoved;
end;

function TChecker.GetOnMoveComplete: TNotifyEvent;
begin
  Result := FOnMoveComplete;
end;

procedure TChecker.SetOnMoveComplete(const Value: TNotifyEvent);
begin
  FOnMoveComplete := Value;
end;

destructor TChecker.Destroy;
var
  i: Integer;
begin
  FMovement.Free;
  for i := 0 to Length(FMaterials) - 1 do
    FMaterials[i].Free;
  inherited;
end;

end.
